home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tk8.4 / demos / image2.tcl < prev    next >
Text File  |  2002-08-12  |  3KB  |  105 lines
  1. # image2.tcl --
  2. #
  3. # This demonstration script creates a simple collection of widgets
  4. # that allow you to select and view images in a Tk label.
  5. #
  6. # RCS: @(#) $Id: image2.tcl,v 1.6 2002/08/12 13:38:48 dkf Exp $
  7.  
  8. if {![info exists widgetDemo]} {
  9.     error "This script should be run from the \"widget\" demo."
  10. }
  11.  
  12. # loadDir --
  13. # This procedure reloads the directory listbox from the directory
  14. # named in the demo's entry.
  15. #
  16. # Arguments:
  17. # w -            Name of the toplevel window of the demo.
  18.  
  19. proc loadDir w {
  20.     global dirName
  21.  
  22.     $w.f.list delete 0 end
  23.     foreach i [lsort [glob -directory $dirName *]] {
  24.     $w.f.list insert end [file tail $i]
  25.     }
  26. }
  27.  
  28. # selectAndLoadDir --
  29. # This procedure pops up a dialog to ask for a directory to load into
  30. # the listobx and (if the user presses OK) reloads the directory
  31. # listbox from the directory named in the demo's entry.
  32. #
  33. # Arguments:
  34. # w -            Name of the toplevel window of the demo.
  35.  
  36. proc selectAndLoadDir w {
  37.     global dirName
  38.     set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1]
  39.     if {[string length $dir] != 0} {
  40.     set dirName $dir
  41.     loadDir $w
  42.     }
  43. }
  44.  
  45. # loadImage --
  46. # Given the name of the toplevel window of the demo and the mouse
  47. # position, extracts the directory entry under the mouse and loads
  48. # that file into a photo image for display.
  49. #
  50. # Arguments:
  51. # w -            Name of the toplevel window of the demo.
  52. # x, y-            Mouse position within the listbox.
  53.  
  54. proc loadImage {w x y} {
  55.     global dirName
  56.  
  57.     set file [file join $dirName [$w.f.list get @$x,$y]]
  58.     image2a configure -file $file
  59. }
  60.  
  61. set w .image2
  62. catch {destroy $w}
  63. toplevel $w
  64. wm title $w "Image Demonstration #2"
  65. wm iconname $w "Image2"
  66. positionWindow $w
  67.  
  68. label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration allows you to view images using a Tk \"photo\" image.  First type a directory name in the listbox, then type Return to load the directory into the listbox.  Then double-click on a file name in the listbox to see that image."
  69. pack $w.msg -side top
  70.  
  71. frame $w.buttons
  72. pack $w.buttons -side bottom -fill x -pady 2m
  73. button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  74. button $w.buttons.code -text "See Code" -command "showCode $w"
  75. pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  76.  
  77. frame $w.mid
  78. pack $w.mid -fill both -expand 1
  79.  
  80. labelframe $w.dir -text "Directory:"
  81. set dirName [file join $tk_library demos images]
  82. entry $w.dir.e -width 30 -textvariable dirName
  83. button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \
  84.     -command "selectAndLoadDir $w"
  85. bind $w.dir.e <Return> "loadDir $w"
  86. pack $w.dir.e -side left -fill both -padx 2m     -pady 2m -expand true
  87. pack $w.dir.b -side left -fill y    -padx {0 2m} -pady 2m
  88. labelframe $w.f -text "File:" -padx 2m -pady 2m
  89.  
  90. listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
  91. scrollbar $w.f.scroll -command "$w.f.list yview"
  92. pack $w.f.list $w.f.scroll -side left -fill y -expand 1
  93. $w.f.list insert 0 earth.gif earthris.gif teapot.ppm
  94. bind $w.f.list <Double-1> "loadImage $w %x %y"
  95.  
  96. catch {image delete image2a}
  97. image create photo image2a
  98. labelframe $w.image -text "Image:"
  99. label $w.image.image -image image2a
  100. pack $w.image.image -padx 2m -pady 2m
  101.  
  102. grid $w.dir -        -sticky ew -padx 1m -pady 1m -in $w.mid
  103. grid $w.f   $w.image -sticky nw -padx 1m -pady 1m -in $w.mid
  104. grid columnconfigure $w.mid 1 -weight 1
  105.